home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Pascal Super Library
/
Pascal Super Library (CW International)(1997).bin
/
TSR
/
TSRSRC35
/
DEVICE.PAS
next >
Wrap
Pascal/Delphi Source File
|
1993-10-19
|
11KB
|
409 lines
{
Display the DOS device driver chain.
Adapted from an assembly language program by Ray Duncan and modified by
several others.
version 3.0 9/2/91
reorganize source code for consistency with other utilities
version 3.1 11/4/91
no change
version 3.2 11/22/91
no change
version 3.3 1/8/92
increase stack space
new features for parsing and getting command line options
version 3.4 2/14/92
no change
version 3.5 10/18/93
display MSCDEX CD-ROM drive letters
}
{$R-,S-,I-,V-,B-,F-,A-,E-,N-,G-,X-}
{$M 4096,0,655360}
program Device_Chain;
uses
Dos,
MemU;
const
MaxDevices = 100; {Maximum number of devices to report}
type
{FCB used to find start of device driver chain}
FileControlBlock =
record
Drive : Byte;
Filename : array[1..8] of Char;
Extension : array[1..3] of Char;
CurrentBl : Word;
LRL : Word;
FilSizeLo : Word;
FilSizeHi : Word;
FileDate : Word;
FileTime : Word;
Other : array[0..7] of Byte;
CurRecord : Byte;
RelRecLo : Word;
RelRecHi : Word;
end;
DisplayRec =
record
StartAddr : Pointer;
Header : CDROMDeviceHeader;
end;
DisplayArray = array[1..MaxDevices] of DisplayRec;
var
DeviceControlBlock : FileControlBlock; {File Control Block for NUL Device}
DevicePtr : ^CDROMDeviceHeader; {Pointer to the next device header}
DeviceSegment : Word; {Current device segment}
DeviceOffset : Word; {Current device offset}
DeviceCount : Word; {Number of devices}
Devices : DisplayArray; {Sortable list of devices}
RawMode : Boolean;
NulStatus : Byte;
procedure Abort(Msg : String);
begin
WriteLn(Msg);
Halt(1);
end;
function FindNulDevice(Segm : Word) : Word;
{-Return the offset of the null device in the specified segment}
var
Ofst : Word;
begin
for Ofst := 0 to 65534 do
if MemW[Segm:Ofst] = $554E then
{Starts with 'NU'}
if Mem[Segm:Ofst+2] = Byte('L') then
{Continues with 'L'}
if (MemW[Segm:Ofst-6] and $801F) = $8004 then begin
{Has correct driver attribute}
FindNulDevice := Ofst-10;
Exit;
end;
Abort('Cannot find NUL device driver');
end;
var
Pivot : DisplayRec;
Swap : DisplayRec;
function PhysAddr(X : Pointer) : LongInt;
{-Return the physical address given by pointer X}
begin
PhysAddr := (LongInt(OS(X).S) shl 4)+OS(X).O;
end;
function Less(X, Y : DisplayRec) : Boolean;
{-Return True if address of X is less than address of Y}
begin
Less := (PhysAddr(X.StartAddr) < PhysAddr(Y.StartAddr));
end;
procedure Sort(L, R : Word);
{-Sort device headers}
var
I : Word;
J : Word;
begin
I := L;
J := R;
Pivot := Devices[(L+R) shr 1];
repeat
{Sort by address}
while Less(Devices[I], Pivot) do
Inc(I);
while Less(Pivot, Devices[J]) do
Dec(J);
if I <= J then begin
Swap := Devices[J];
Devices[J] := Devices[I];
Devices[I] := Swap;
Inc(I);
Dec(J);
end;
until I > J;
if L < J then
Sort(L, J);
if I < R then
Sort(I, R);
end;
procedure WriteHelp;
{-Write a simple help screen}
begin
WriteLn;
WriteLn('DEVICE produces a report showing the device drivers loaded into the system as');
WriteLn('well as how much memory each uses, and what interrupt vectors are taken over.');
WriteLn;
WriteLn('DEVICE accepts the following command line syntax:');
WriteLn;
WriteLn(' DEVICE [Options]');
WriteLn;
WriteLn('Options may be preceded by either / or -. Valid options are as follows:');
WriteLn(' /R raw, unsorted report.');
WriteLn(' /? write help screen.');
Halt(1);
end;
procedure GetOptions;
{-Check for command line options}
var
Arg : String[127];
procedure GetArgs(S : String);
var
SPos : Word;
begin
SPos := 1;
repeat
Arg := NextArg(S, SPos);
if Arg = '' then
Exit;
if Length(Arg) = 2 then
if (Arg[1] = '/') or (Arg[1] = '-') then
case Upcase(Arg[2]) of
'R' : RawMode := True;
'?' : WriteHelp;
end;
until False;
end;
begin
RawMode := False;
{Get arguments from the command line and the environment}
GetArgs(StringPtr(Ptr(PrefixSeg, $80))^);
GetArgs(GetEnv('DEVICE'));
end;
function GetName(Header : CDROMDeviceHeader) : String;
{-Get a device name}
const
Plural : array[Boolean] of String[1] = ('', 's');
var
Num : String[3];
begin
with Header do
if (Attributes and $8000) <> 0 then begin
if (Attributes = $C800) and (Header.DriveLet <> 0) then
{An MSCDEX CD-ROM}
GetName := DeviceName+'('+
Char(Byte('A')+Header.DriveLet-1)+':)'
else
GetName := DeviceName;
end else begin
Str(Ord(DeviceName[1]), Num);
GetName := Num+' Block Unit'+Plural[Ord(DeviceName[1]) <> 1];
end;
end;
procedure RawReport;
{-Raw, unsorted device report}
var
D : Word;
begin
WriteLn;
WriteLn(' Starting Next Strategy Interrupt Device');
WriteLn(' Address Hdr Addr Attr Entry Pnt Entry Pnt Name');
WriteLn('--------- --------- ---- --------- --------- --------');
for D := 1 to DeviceCount do
with Devices[D], Header do
WriteLn(HexPtr(StartAddr), ' ',
HexW(NextHeaderSegment), ':', HexW(NextHeaderOffset), ' ',
HexW(Attributes), ' ',
HexW(DeviceSegment), ':', HexW(StrategyEntPt), ' ',
HexW(DeviceSegment), ':', HexW(InterruptEntPt), ' ',
GetName(Header));
end;
function GetCommandPtr(DosPtr : DosRecPtr) : Pointer;
{-Get the address of COMMAND.COM}
type
McbRec =
record
ID : Char;
PSPSeg : Word;
Len : Word;
end;
var
McbPtr : ^McbRec;
begin
McbPtr := Ptr(DosPtr^.McbSeg, 0);
McbPtr := Ptr(OS(McbPtr).S+McbPtr^.Len+1, 0);
GetCommandPtr := Ptr(McbPtr^.PSPSeg, 0);
end;
procedure WriteDevice(StartAddr : Pointer;
Name : String;
Start, Stop : LongInt;
ShowVecs : Boolean);
{-Write data for one device}
var
Size : LongInt;
VecAddr : LongInt;
Vec : Byte;
Cnt : Byte;
BPtr : ^Byte;
begin
Size := Stop-Start;
ShowVecs := ShowVecs and (Size <> 0);
Write(HexPtr(StartAddr), ' ');
if Size <> 0 then
Write(Size:6)
else
Write(' -');
if ShowVecs then
while Length(Name) < 14 do
Name := Name+' ';
Write(' ', Name);
if ShowVecs then begin
Cnt := 0;
for Vec := 0 to $80 {!!} do begin
VecAddr := PhysAddr(Pointer(MemL[0:4*Vec]));
if (VecAddr >= Start) and (VecAddr < Stop) then
{Points to this memory block}
if Byte(Pointer(VecAddr)^) <> $CF then begin
{Doesn't point to IRET}
if Cnt >= 12 then begin
WriteLn;
Write(' ');
Cnt := 0;
end;
inc(Cnt);
Write(' ', HexB(Vec));
end;
end;
end;
WriteLn;
end;
procedure SortedReport;
{-Sorted report better for user consumption}
const
NulDevice : array[1..8] of Char = 'NUL ';
var
D : Word;
DosCode : Pointer;
CommandPtr : Pointer;
DosPtr : DosRecPtr;
DosBuffers : SftRecPtr;
Start : LongInt;
Stop : LongInt;
FoundNul : Boolean;
begin
{Pointer to DOS variables}
DosPtr := Ptr(OS(DosList).S, OS(DosList).O-2);
{Get the address of the lowest DOS code}
DosCode := Ptr(OS(Devices[1].StartAddr).S, 0);
{Get the address of the start of DOS's file tables}
DosBuffers := DosPtr^.FirstSFT^.Next;
{Get pointer to command.com}
CommandPtr := GetCommandPtr(DosPtr);
WriteLn;
WriteLn(' Address Bytes Name Hooked vectors');
WriteLn('--------- ------ -------------- --------------');
{ ssss:oooo ssssss nnnnnnnn xx xx xx xx xx}
{Display the devices}
FoundNul := False;
for D := 1 to DeviceCount-1 do begin
if FoundNul then begin
Start := PhysAddr(Devices[D].StartAddr);
Stop := PhysAddr(Devices[D+1].StartAddr);
end else if GetName(Devices[D].Header) = NulDevice then begin
FoundNul := True;
Start := PhysAddr(DosCode);
Stop := PhysAddr(Devices[D+1].StartAddr);
end else begin
Start := 0;
Stop := 0;
end;
{Protect against devices patched in after DOS}
if Stop > PhysAddr(DosBuffers) then begin
WriteLn('Detected device drivers patched in after CONFIG.SYS');
Exit;
end;
with Devices[D] do
WriteDevice(StartAddr, GetName(Header), Start, Stop, True);
end;
{Last device}
with Devices[DeviceCount] do begin
Start := PhysAddr(StartAddr);
Stop := PhysAddr(DosBuffers);
WriteDevice(StartAddr, GetName(Header), Start, Stop, True);
end;
{DOS buffers}
Start := PhysAddr(DosBuffers);
Stop := PhysAddr(CommandPtr);
WriteDevice(DosBuffers, 'DOS buffers', Start, Stop, False);
end;
begin
WriteLn('DEVICE ', Version, ', Copyright 1993 TurboPower Software');
GetOptions;
{Find the start of the device driver chain via the NUL device}
FillChar(DeviceControlBlock, SizeOf(DeviceControlBlock), 0);
with DeviceControlBlock do begin
Filename := 'NUL ';
Extension := ' ';
asm
mov ax,$0F00
mov dx,offset devicecontrolblock
int $21
mov NulStatus,al
end;
if NulStatus <> 0 then
Abort('Error opening the NUL device');
if Hi(DosVersion) > 2 then begin
{DOS 3.0 or later}
DeviceSegment := 0;
DeviceOffset := FindNulDevice(DeviceSegment);
end else begin
{DOS 2.x}
DeviceOffset := Word(Pointer(@Other[1])^);
DeviceSegment := Word(Pointer(@Other[3])^);
end;
DevicePtr := Ptr(DeviceSegment, DeviceOffset);
end;
{Scan the chain, building an array}
DeviceCount := 0;
while OS(DevicePtr).O <> $FFFF do begin
if DeviceCount < MaxDevices then begin
Inc(DeviceCount);
with Devices[DeviceCount] do begin
StartAddr := Pointer(DevicePtr);
Header := DevicePtr^;
end;
end;
with DevicePtr^ do
DevicePtr := Ptr(NextHeaderSegment, NextHeaderOffset);
end;
if RawMode then
RawReport
else begin
{Sort the array in order of starting address}
Sort(1, DeviceCount);
SortedReport;
end;
end.